home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PASCALL / CLOCKIN / CLOCK4.PAS < prev    next >
Pascal/Delphi Source File  |  1992-12-25  |  4KB  |  152 lines
  1. program graphclock;
  2. uses
  3.      graph,graphin1,dos,crt;
  4. label
  5.      1;
  6. var
  7.      beeper,stop:boolean;
  8. const
  9.      lasthour:word=hrhandsize;
  10.      lastminute:word=minhandsize;
  11.      lastsecond:word=sechandsize;
  12.      lasthundrethofasecond:word=hndthsechandsize;
  13. var
  14.      hour,minute,second,hundrethofasecond:word;
  15.      txh,txw,txs,tys:integer;
  16.  
  17.  
  18. function printmonth(month:word):string;
  19. begin
  20.      case month of
  21.           1: printmonth:='january';
  22.           2: printmonth:='february';
  23.           3: printmonth:='march';
  24.           4: printmonth:='april';
  25.           5: printmonth:='may';
  26.           6: printmonth:='june';
  27.           7: printmonth:='july';
  28.           8: printmonth:='august';
  29.           9: printmonth:='september';
  30.           10: printmonth:='october';
  31.           11: printmonth:='november';
  32.           12: printmonth:='december'
  33.           else exit;
  34.      end;
  35. end;
  36.  
  37.  
  38. function printdayofweek(day:word):string;
  39. begin
  40.      case day of
  41.           0: printdayofweek:='sunday';
  42.           1: printdayofweek:='monday';
  43.           2: printdayofweek:='tuesday';
  44.           3: printdayofweek:='wednesday';
  45.           4: printdayofweek:='thursday';
  46.           5: printdayofweek:='friday';
  47.           6: printdayofweek:='saturday'
  48.           else exit;
  49.      end;
  50. end;
  51.  
  52. procedure preset;
  53. begin
  54.      txh:=textheight('d');
  55.      txw:=textwidth('d');
  56.      setcolor(white);
  57.      txs:=textwidth('  :  :  .   ');
  58. {     txs:=centerx-(txs-txw div 2) div 2;}
  59.      tys:=centery-txh div 2;
  60. {     outtextxy(txs+1,tys+1,'  :  :  .   ');}
  61. end;
  62.  
  63. procedure putoutclocktimer;
  64. {const
  65.      lasthour:word=hrhandsize;
  66.      lastminute:word=minhandsize;
  67. }{     lastsecond:word=sechandsize;}
  68. {     lasthundrethofasecond:word=hndthsechandsize;
  69. var
  70.      hour,minute,second,hundrethofasecond:word;
  71.      txh,txw,txs,tys:integer;}
  72. var
  73.      txx:integer;
  74. begin
  75.           setcolor(white);
  76.           txx:=centerx-(txs-txw div 2) div 2;
  77.           bar(txx,tys,txx+11*txs,tys+txh);
  78.           outtextxy(txx+1,tys+1,concat(streng(hour),':',streng(minute),':',streng(second),'.',streng(hundrethofasecond)));
  79.           gettime(hour,minute,second,hundrethofasecond);
  80.                puthand(lastsecond,second,sec);
  81.                bar(txs+6*txw,tys,txs+8*txw,tys+txh);
  82.                if (beeper) and not(lastsecond=second) then beep;
  83.                lastsecond:=second;
  84.                puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
  85.                lasthundrethofasecond:=hundrethofasecond;
  86. end;
  87.  
  88. function inkey:char;
  89. begin
  90.      if keypressed then inkey:=readkey else inkey:=chr(1);
  91. end;
  92.  
  93. procedure putoutclock;
  94. const
  95.      lasthour:word=hrhandsize;
  96.      lastminute:word=minhandsize;
  97.      lastsecond:word=sechandsize;
  98.      lasthundrethofasecond:word=hndthsechandsize;
  99. var
  100.      hour,minute,second,hundrethofasecond:word;
  101. begin
  102.      repeat
  103.           gettime(hour,minute,second,hundrethofasecond);
  104. {          if not(lasthour=hour) then begin}
  105.                puthand(lasthour,hour,hr);
  106. {               lasthour:=hour;
  107.           end;
  108.           if not(lastminute=minute) then begin}
  109.                puthand(lastminute,minute,min);
  110. {               lastminute:=minute;
  111.           end;
  112.           if not(lastsecond=second) then begin}
  113.                puthand(lastsecond,second,sec);
  114.                if beeper then beep;
  115. {               lastsecond:=second;
  116.           end;
  117.           if not(lasthundrethofasecond=hundrethofasecond) then begin}
  118.                puthand(lasthundrethofasecond,hundrethofasecond,hndthsec);
  119. {               lasthundrethofasecond:=hundrethofasecond;
  120.           end;}
  121.      until keypressed;
  122. end;
  123.  
  124. procedure done;
  125. begin
  126.      restorecrtmode;
  127.      closegraph;
  128.      halt;
  129. end;
  130.  
  131. procedure doit;
  132. begin
  133. {          bar(centerx-241,0,centerx+241,0);
  134.           cleardevice;}
  135.           putoutclocktimer;
  136.           case ord(upcase(inkey)) of
  137.                27:done;
  138.                ord('S'):beeper:=not(beeper);
  139.           end;
  140.           centerc:=centerx;
  141. end;
  142.  
  143. begin
  144.      beeper:=true;
  145.      setupgraph;
  146.      setupgrid;
  147.      preset;
  148. 1:
  149.      for centerx:=241 to 399 do doit;
  150.      for centerx:=399 downto 241 do doit;
  151.      goto 1;
  152. end.